home *** CD-ROM | disk | FTP | other *** search
- ;;;
- ;;; $Id: irchat-dcc.el,v 1.1 1994/02/23 15:05:00 tmo Exp $
- ;;;
- ;;; see file irchat-copyright.el for change log and copyright info
- ;;;
- ;;; This file:
- ;;; Copyright 1994 Kim Nyberg <kny@tekla.fi>
- ;;; All Rights Reserved
-
-
- (defvar irchat-dcc-receive-list nil)
- (defvar irchat-dcc-receive-direct nil)
-
-
- (defun irchat-ctl-a-dcc-msg (from rest)
- (insert (format "*** DCC from %s: %s\n" from rest))
- (if (string-match
- "\\(SEND\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" rest)
- (let ((command "receive")
- (filename (matching-substring rest 2))
- (host (matching-substring rest 3))
- (port (matching-substring rest 4))
- (size (matching-substring rest 5)))
- (setq irchat-dcc-receive-list
- (append irchat-dcc-receive-list
- (list (list command host port size filename))))
- (if irchat-dcc-receive-direct
- (irchat-Command-dcc-receive)))))
-
-
- (defun irchat-Command-dcc-send ()
- "Send file to user."
- (interactive)
- (let ((filename (expand-file-name (read-file-name
- "File to send: "
- default-directory nil))))
- (setq irchat-privmsg-partner
- (irchat-completing-default-read
- "To whom: "
- (append irchat-nick-alist irchat-channel-alist)
- '(lambda (s) t)
- nil irchat-privmsg-partner))
- (set-process-filter
- (start-process irchat-dcc-program nil
- irchat-dcc-program "send"
- (int-to-string irchat-dcc-port)
- filename)
- 'irchat-dcc-send-filter)
- (setq irchat-dcc-port (1+ irchat-dcc-port))))
-
-
- (defun irchat-dcc-send-filter (process output)
- (cond ((string-match "DCC file [^ ]* sent" output)
- (irchat-own-message (substring output 0 (1- (length output))))
- (message ""))
- ((string-match
- "DCC send [^ ]*/\\([^ ]*\\) \\([^ ]+\\) \\([^ ]+\\) \\(.+\\)" output)
- (let ((filename (matching-substring output 1))
- (port (matching-substring output 2))
- (machine (matching-substring output 3))
- (size (matching-substring output 4)))
- (irchat-send "PRIVMSG %s :DCC SEND %s %s %s %s %s"
- irchat-privmsg-partner filename machine port size)
- (irchat-own-message
- (format "*** Sending file %s (%s bytes) to %s"
- filename size irchat-privmsg-partner))))
- ((string-match "ERROR.*" output)
- (irchat-own-message (format "*** DCC %s" output)))
- ))
-
-
- (defun irchat-Command-dcc-receive (&optional number)
- "Receive next file from list."
- (interactive "P")
- (let ((dcc-object (car irchat-dcc-receive-list)))
- (setq irchat-dcc-receive-list (cdr irchat-dcc-receive-list))
- (if dcc-object
- (let ((command (car dcc-object))
- (host (nth 1 dcc-object))
- (port (nth 2 dcc-object))
- (size (nth 3 dcc-object))
- (default (nth 4 dcc-object)))
- (irchat-own-message
- (format "*** Getting file %s (%s bytes)" default size))
- (let ((filename (expand-file-name default irchat-dcc-directory)))
- (set-process-filter
- (start-process irchat-dcc-program nil irchat-dcc-program
- command host port size filename)
- 'irchat-dcc-receive-filter))))))
-
-
- (defun irchat-dcc-receive-filter (process output)
- (if (string-match "DCC file [^ ]* received" output)
- (irchat-own-message (substring output 0 (1- (length output))))
- (message "%s" (substring output 0 (1- (length output))))))
-
-
- (defun irchat-Command-dcc-list ()
- "List files in receive queue."
- (interactive)
- (let* ((dcc-list irchat-dcc-receive-list)
- dcc-object)
- (while dcc-list
- (setq dcc-object (car dcc-list)
- dcc-list (cdr dcc-list))
- (let ((filename (cdr (cdr (cdr (cdr dcc-object)))))
- (size (car (cdr (cdr (cdr dcc-object))))))
- (irchat-own-message
- (format "*** DCC file %s (%s bytes)" filename size))))))
-
- (provide 'irchat-dcc)
- ;;;
- ;;; eof
- ;;;
-